C  WORDS,  NAMEXT, TYPOUT
	
	SUBROUTINE WORDS
	INTEGER PWDS
	COMMON R2,JA,RC,J2,R3,R4,R5,R6,R7,X,IA,N
	1,Z,J,KN,ISET,KNT,Q(26),JR /PTR/PWDS(1)
	1 /LIMIT/LIMIT,ITEM,LL,IS,IX
C  /SCX/ IS ALSO IN SCMSS, NOTBMS, RHYTH, BEAMS, NEWR(IN LOOP.FAI), SCAN.FAI
C **** WHEN JALPHA IS EXTENDED FIX LOOP AT 365 AND SUBR. NEWR(IN LOOP)
C **** AND SUBR. SCMSS, NOTBMS, RHYTH AND BEAMS
	COMMON/SCX/ICOM,MINUS,IDOT,IEQ,LPRN,IRPRN,IPLUS,ISTAR,ICOLON,
	1 ISEMI,IDBQT,IBLA,IDOL,IPRCNT,IANPR,IAT,INUM,LESS,IGT,IAPOS,
	1 IQUES,IEXCLA,LBRK,RBRK,UPAR,DNAR,DBLAR,SLA,XX,ZZ,
	1 J4,L,Y,K,RX,RZ,RA,J5  /XRN/RN(1) /ALF/INP(72),ML
	COMMON/SCN/KEL,KR,KU,KD,KSLA,NONO(30)
CC	COMMON/SCN/LEL,LR,LU,LD,KSLA,LE,LC,LS,LF,LA,LI,LW
	DIMENSION IAZ(26),JALPHA(30)
	COMMON/A2Z/LA,LB,LC,LD,LE,LF,LG,LH,LI,LJ,LK,LEL,LM,
	1 LN,LO,LP,LQ,LR,LS,LT,LU,LV,LW,LX,LY,LZ
	EQUIVALENCE (ICOM,JALPHA),(INP2,INP(2)),(IAZ,LA),(LSQ,JALPHA(23))
	DATA LEL/'L'/,LR/'R'/,LU/'U'/,LD/'D'/,LE/'E'/,KSLA/'/'/
	1,LC/'C'/,LS/'S'/,LF/'F'/,LA/'A'/,LI/'I'/,LW/'W'/,XFONT/50./
	DATA IAZ/'A','B','C','D','E','F','G','H','I','J','K','L','M',
	1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/,
	1 IBKSL/"561004020100/
C  IBKSL=\   BACKSLASH - NOT USED YET  5/80
	DATA JALPHA/',','-','.','=','(',')','+','*',':',';'
	1 ,'"',' ','$','%','&','@','#','<','>',1H','?','!'
	1 ,"555004020100,"565004020100,"571004020100,"5004020100,
	1 "135004020100,'/',"755004020100,"771004020100/
C 1ST 2 BIG NUMS ARE [, ], ↑, ↓, ↔, ... {, }
C                  1/4 1/2 #  b nat.   --- 1/8
C   FOR ENTERING TEXT: T, POS., STF., NT#., SIZE
	KNT=-1
C COUNTER FOR SEPARATE TEXT ITEMS.
431	FORMAT(72A1)
131	CALL TYPE
531	DO 31 KN=72,1,-1
31	IF(INP(KN).NE.IBLA)GO TO 33
C  KN=NUM OF CHARACTERS
C  DON'T END WITH '*' IN 'LETTERS' INPUT!!!!!!!!
C  , - . = ( ) + * : ; " BLANK (FONTS) ' --THIS IS ORDER PAST ALPHAB.
C ?[=1/8 NOTE, [=QTR NOTE, ]=HALF NOTE, ↑=#, ↓=b, ↔=NATURAL, 2 SLOTS STILL OPEN

C  50 &=NON-ITALICS(BDR), 51 @=ITALICS(BDI)
C  48 &&=BDL (LIGHT-FACE)     49 IS STILL FREE ****
C  52 #=RETURN TO PRIMITVE FONT, 53 <=OPEN, 54 >=FILLED. ('=55)
C FRENCH ACCENTS=ACCUTE=64, GRAVE=65, CMFLX=66, UMLT=67, CIDLA=68, 69 =EIGHTH NOTE
C                 <<          >>       $$        %%       ##
33	L=1
	RC=0
	IF(INP(KN).NE.KSLA)GO TO 333
	IF(INP(KN+1).NE.KSLA)GO TO 133
C  TYPE // TO PRINT A SINGLE SLASH.  (NO SPACE BETWEEN!)
333	KN=KN+1
	INP(KN)=KSLA
C  SO TRAILING BLANKS ARE DELETED.
133	LL=1
	RZ=0 
	ISET=IS
	IF(R3.LT.1000)GO TO 233
	RZ=1
	R3=R3-1000.
	RC=R3
C  ADD 1000 TO POSITION (R3+1000) FOR CENTERING AT POS. R3.
233	RA=R3
C   RA= ADDS UP TOTAL SPACE NEEDED
	RX=0
C  FOR SETLET
C******** DASH
368	KA=INP(L)
	IF(KA.NE.'?'.AND.KA.NE.'!')GO TO 117
C /??/ = PUT IN LONG DASH TO DIVIDE SYLLABLES.  BUT MUST BE EDITED LATER!!!!!
C /!!/ = PUT IN SHORT DASH TO DIVIDE SYLLABLES.  BUT MUST BE EDITED LATER!!!!!
	IF(INP(L+1).NE.KA)GO TO 117
	IA=L
	L=L+2
217	IF(INP(L).EQ.'/')GO TO 317
	L=L+1
	IF(L.LT.KN)GO TO 217
317	ML=L
	DO 417 N=IA,KN
	ML=ML+1
	INP(N)=INP(ML)
C GET RID OF /??  AND SLIDE DATA TO LEFT.
417	INP(ML)=IBLA
	KN=KN-(L-IA)-1
	L=IA
CC	L=L+1
817	RN(IS)=8.
	RN(IS+1)=4.
	RN(IS+2)=R2
	RN(IS+3)=RA-4.
	RN(IS+4)=R4
	RN(IS+5)=R4
	RN(IS+6)=RA
	RN(IS+7)=0
	RN(IS+8)=0
	RN(IS+9)=0
	RN(IS+10)=1.
	IF(KA.NE.'!')GO TO 917
C NOW SHORT DASHES
	RN(IS+7)=1.
	RN(IS+10)=2.
917	IS=IS+11
	RZ=0
	GO TO 1370
C******** DASH
117	RN(IS+1)=16
	RN(IS+3)=RA
C  NEXT IS A MAGIC NUMBER FOR SPACING LETTERS.
CC	Y=39.6*RSTJ3
C  RBL IS FOR CONTROL(NON-LETTERS, ETC.) CHARACTERS.
	RN(IS+2)=R2
	RN(IS+4)=R4
	CALL NOZERO(R5)
	RN(IS+5)=R5
	IF(R5.GE.100)R5=R5-100
C >100 FOR TEXT IN ORCH SCORES TO GO IN ALL SEP. PARTS.
CKK	KK=0
	DO 364 J5=6,8
	Z=0
CXX	DO 363 J4=1,4
	J4=1
361	IA=INP(L)
	IF(IA.NE.KSLA)GO TO 365
C  NEG. SPACE IS ENTERED IN P1 FOR EACH "FIRST" ITEM.
	IF(INP(L+1).NE.KSLA)GO TO 433
C  TYPE // TO PRINT A SINGLE SLASH.  (NO SPACE BETWEEN!)
CKK	KK=KK+1
	L=L+1
	GO TO 365
433	J3=J4
	DO 367 KA=J5,8
	X=99.
	DO 366 K=J3,4
	Z=Z+X
366	X=X*100.0
	RN(IS+KA)=Z
	J3=1
367	Z=0
	L=L+1
C  L=CHARACTER COUNTER
	GO TO 369
365	DO 362 J=1,30
	IF(IA.NE.JALPHA(J))GO TO 362
CC	IF(J.NE.21)GO TO 360
C NOW '?'
CC	IF(INP(L+1).NE.LSQ)GO TO 360
C NOW '?[' = EIGHTH NOTE   N=69
CC	L=L+1
CC	J=34
360	N=35+J
C  FOUND A SPECIAL CHARACTER.
	IF(N.EQ.65)N=69
C NOW '}' = EIGHTH NOTE   N=69
	K=N
	IFNT=0
	IF(N.LT.48)GO TO 39
	IF(N.GT.54)GO TO 39
	IF(IA.NE.INP(L+1))GO TO 39
C NEXT FOR DBL CHARS.
	GO TO(1,2,3,39,7,4,5)N-47
C FOR FRENCH ACCENTS
1	N=66
CIRCUMFLEX   TYPE $$
	GO TO 6
2	N=67
C UMLAUT   TYPE %%
	GO TO 6
3	N=48
C &&=BDL40 FONT
	GO TO 6
4	N=64
C ACCUTE  TYPE >>
	GO TO 6
7	N=68
C CEDILLA  TYPE ##
	GO TO 6
5	N=65
C GRAVE  TYPE <<
CC	IF(N.NE.50)GO TO 39
CC	IF(IA.NE.INP(L+1))GO TO 39
6	K=N
	L=L+1
C  TYPE && FOR LIGHT-FACE (BDL).  PUSH PTR (L) ALONG 1 MORE.
	GO TO 39
362	CONTINUE
38	N=10-(LA-INP(L))/536870912
C   MAGIC NUMBER TO FIND LETTERS
	IF(N.LT.10)N=N+7
	K=N
	IF(KFNT)IFNT=0
	IF(N.LT.40)GO TO 39
	N=N+28
	KFNT=-1
C  TO INITIALIZE AUTOMATIC LOWER CASE SYSTEM.
	K=N-60
C  K IS ACTUAL LETTER NUMB. (a=10, ETC.)
	IFNT=-1
C LOWER CASE LETTERS ARE 60 .GT. UPPER. A=10, a=70, b=71, etc.
39	L=L+1
C  BLANK=47  =99 WHEN NO MORE CHARS TO COME.
C*********** NEW 12/79 ****** ALSO CHANGE 363 LOOP******************
	IF(N.LT.48.OR.N.GT.52)GO TO 392
C SAVE THE FONT CODE
	XFONT=N
	GO TO 391
392	IF(J4.NE.1)GO TO 391
C SKIP IF FONT CODE OR NOT 1ST CHAR. OF GROUP
	IF(RX.NE.0)GO TO 391
	IF(RZ.NE.0)GO TO 391
C PUTS FONT CODE AT FIRST OF EACH CHAR. GROUP.
	J4=J4+1
	Z=XFONT*1000000.
C*******************************************************
391	IF(N.LT.64.OR.N.GT.68)CALL SPACER(K,IFNT,RX,3.32)
CC  63=SLASH     391	IF(N.LT.63.OR.N.GT.68)CALL SPACER(K,IFNT,RX,3.32)
C  NUM↑↑=19.7/5.96  FOR BASIC SPACE PER LETTER.
C  GET SPACE FOR THIS LETTER.  IGNORE ACCENTS (63-68)
	X=N
	IF(J4.EQ.2)X=X*10000.
	IF(J4.EQ.3)X=X*100.
	IF(J4.EQ.1)X=X*1000000.
363	Z=Z+X
	J4=J4+1
	IF(J4.LE.4)GO TO 361
364	RN(IS+J5)=Z
369	RN(IS+9)=RX
	RN(IS+10)=RZ
	IF(RZ.EQ.0)KNT=KNT+1
	IF(RC.NE.0)RN(IS+10)=RC
	RC=0
C  FOR CONTINUATION
	RA=RA+RX*R5
	IF(IA.EQ.KSLA)RA=RA+5
C  SPACES GROUPS DIVIDED BY SLASHES
	RX=0
C***	IF(RZ.NE.0)GO TO 370
C  SKIP IF P10=1, REQUIRED FOR CONTINUATION OF TEXT.
C***	IF(IBLANK(IS,7))RZ=-2
C IF LAST CHAR IN P7 IS BLANK RESET WDCNT, GET RID OF P8 AND P9
C***	IF(IBLANK(IS,6))RZ=-3
C ↑↑↑↑ LAST CHAR IN P6=BLNK ZAPS P7 IF NOT NEEDED. RZ=- CHANGES WORDCNT
C***370	RN(IS)=7+RZ
C NOW WILL PUT SIZE INTO P9 ALWAYS.  (FOR CODE 4 DASH CENTERING FEATURE.)
370	IF(RZ.LT.0)RZ=0 
C***370	RN(IS)=7+RZ
       	RN(IS)=7+RZ
	IS=IS+10+RZ
	RZ=1.
	IF(IA.EQ.KSLA)RZ=0
1370	LL=LL+1
	PWDS(ITEM+LL)=IS
C  PUT IT IN THE PNTR ARRAY
	IF(L.LT.KN)GO TO 368
C   WAS ↑↑↑↑↑↑↑ .LE.    5/22/76

	IX=ITEM+LL-1
C IX IS FOR DASHES
	IF(KNT.GT.0)CALL SETLET
C  GOES TO SETLET AUTOMATICALLY IF MORE THAN ONE SLASH FOUND.
	IF(KFNT)IFNT=0
	KFNT=0
	INP(1)=0
C   SO IT WON'T FIND A COMMAND IN THE MAIN PROG.
	END
C  PACKS 4 CHARS/WD, 3 WDS/ITEM.

CC	SUBROUTINE NAMEXT(JA,NAME,IEXT)
	SUBROUTINE DUMMY
	COMMON /MKX/MKX(7),PRNL
	DIMENSION JA(1),A(5),FM(7)
	DATA A/'A1','A2','A3','A4','A5'/,FM(1)/'('/
	EQUIVALENCE (A5,A(5)),(FM2,FM(2)),(FM3,FM(3)),(FM4,FM(4)),
	1 (FM5,FM(5)),(FM6,FM(6)),(FM7,FM(7)),(A3,A(3))
	DO 9 K=2,7
9	FM(K)=' '
	ID=0
	IA=0
	NAME=' '
	DO 1 K=20,1,-1
	IF(JA(K).EQ.' ')GO TO 1
5	DO 2 L=K-1,1,-1
	J=JA(L)
	IF(J.NE.' ')GO TO 3
	IA=L
	GO TO 4
3	IF(J.NE.'.')GO TO 2
	ID=L
	K=L
C '.' ASSUMES THERE IS AN EXTENSION 
	GO TO 5
2	CONTINUE
	GO TO 4
1	CONTINUE
C ALL BLANK IF WE GET HERE
	RETURN
4	IF(IA.NE.0)GO TO 6
	IF(JA(1).EQ.-1)RETURN
C  ↑↑↑ FOR 'RS', 'SA', 'G', ETC. WITH NO NAME FOLLOWING.
	IF(ID.NE.0)GO TO 7
C NOW ONLY A NAME IS ON THIS LINE
	FM2=A5
	FM3=PRNL
C GET LEFT PARENTHESIS
	REREAD FM,NAME
	GO TO 10
7	FM3=',A1,'
	FM2=A(ID-1)
	FM4=A3
	FM5=PRNL
C  FOUND NAME AND EXTENSION
	REREAD FM, NAME,K,IEXT
	GO TO 11
6	IF(IA.GT.5)RETURN
C .GT.5 = TOO MUCH IN FRONT OF NAME!!
	FM2=A(IA)
	FM3=','
	IF(ID.NE.0)GO TO 8
	FM4=A5
	FM5=PRNL
C  FOUND  'WORD', NAME    WORD= SA, RS, GM, ETC.
	REREAD FM,K,NAME
	GO TO 10
8	FM4=A(ID-IA-1)
	FM5=',A1,'
	FM6=A3
	FM7=PRNL
	REREAD FM,K,NAME,K,IEXT
11	CALL LO2UP(IEXT)
10	CALL LO2UP(NAME)
	END

	SUBROUTINE TYPOUT
	COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,
	1 JX,ISM,IQ,VX(50),IMP,K,KN,M,MD,IBLA /ALF/INP(72) /IDEV/IDEV
	IF(IDEV.NE.5)RETURN
	DO 1 KK=72,1,-1
1	IF(INP(KK).NE.IBLA)GO TO 2
2	CALL TYPINT(MODE)
	CALL TYPCHR('   ',3)
	DO 3  KKK=1,KK
3	CALL TYPCHR(INP(KKK),1)
	CALL TYPCRLF
	END

	SUBROUTINE PACKX(NAM,KNM)
	DIMENSION KNM(5)
	DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
	1 , MM/"774000000000/
	NAM=0
	DO 12 K=5,1,-1
	NAM=NAM .OR. (KNM(K) .AND. MM)
	IF (K.EQ.1)RETURN
17	IF (NAM.GE.0)GO TO 13
	NAM = (( NAM .AND. LL)/KK) .OR. JJ
	GO TO 12
13	NAM = NAM / KK
12	CONTINUE
	RETURN
	END

	SUBROUTINE NAMEXT(I,NAME,IEXT)
C FINDS NAME.EXT IN A1 STRING
	DIMENSION I(1)

	IF(I(1).NE.-1)GO TO 9
C FIRST PASS UP 'G', 'GM', 'RS', ETC.  (=-1)
	DO 1 K=1,72
1	IF(I(K).EQ.' ')GO TO 2
C NOW PASS BLANKS
2	J=72
	DO 3 J=K+1,72
3	IF(I(J).NE.' ')GO TO 4
C NOW FOUND START OF WORD (UNLESS ALL BLANKS)
4	IF(J.NE.72)GO TO 5
	NAME=' '
	RETURN
9	J=1
5	DO 6 K=J,72
	IF(I(K).EQ.' ')GO TO 7
C JUMP IF NAME ONLY
6	IF(I(K).EQ.'.')GO TO 8
7	CALL PACKX(NAME,I(J))
	RETURN
8	CALL RLOOP(I(61),I(J),K-J)
	CALL PACKX(NAME,I(61))
	CALL PACKX(IEXT,I(K+1))
	END